home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / comm / misc / mirrorman_1_10b1.lha / MirrorManager-1.10b1 / rexx / CutTree.mm < prev    next >
Text File  |  1994-06-24  |  8KB  |  313 lines
  1. /*rx
  2.     $VER: $Id: CutTree.mm,v 1.7 1994/06/20 01:08:10 tf Exp $
  3.  
  4.     Remove recursively all empty directories in a given path.
  5.  
  6.     This ARexx script needs the AmigaDOS commands "List", "Delete"
  7.     and "Protect" available in your path.
  8.  
  9.     Initial revision by Tobias Ferber, 20-Mar-94
  10. */
  11.  
  12. options results
  13. options failat 10
  14.  
  15. /* initialize globals */
  16.  
  17. pathname = ""
  18. template = "PATH/K/A,AUTO/S"
  19. tempfile = "T:CutTreeTemp." || pragma('Id')
  20. tempsize = "T:CutTreeSizeTemp." || pragma('Id')
  21. args     = ""
  22. cliopts  = ""
  23.  
  24. dg       = 0  /* gauge increment */
  25. gstepN   = 0
  26.  
  27. ESC      = '1b'x
  28.  
  29. signal on HALT
  30. signal on BREAK_C
  31. signal on BREAK_D
  32.  
  33. /* parse args */
  34.  
  35. do ac=1 while ac <= arg()
  36.   av= arg(ac)
  37.   select
  38.     when upper(av) = "PATH" then do
  39.       if ac < arg() then do
  40.         ac= ac+1
  41.         pathname= arg(ac)
  42.         if words(pathname) < 1 then pathname= pragma('D')
  43.         end
  44.       else exit bad_args('Missing pathname after' ESC'bPATH'ESC'n keyword.')
  45.       end /* PATH */
  46.  
  47.     when upper(av) = "AUTO" then cliopts = cliopts || 'a'
  48.  
  49.     otherwise exit bad_args('Unknown keyword:' ESC'b' || av || ESC'n')
  50.  
  51.   end /* select */
  52.  
  53. end /* do */
  54.  
  55. call pragma('W','N')
  56.  
  57.  
  58. /* try to get missing pathname */
  59.  
  60. if words(pathname) < 1 then do
  61.   cwd= strip(pragma('D'),'B','"')
  62.   REQUESTFILE DRAWER '"'cwd'"' TITLE '"Delete empty drawers in ..."' DRAWERSONLY NOICONS SAVEMODE
  63.   if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then pathname= result
  64.   end
  65.  
  66. if words(pathname) < 1 then
  67.   exit bad_args("Not enough arguments for CutTree...  Exiting...")
  68.  
  69. if ~exists(pathname) then do
  70.   REQUESTCHOICE TITLE   '"CutTree Request"',
  71.                 BODY    '"CutTree failed to locate your directory*n*n' ||,
  72.                         ESC'c'ESC'b' || pathname || ESC'n'ESC'l'       || '"',
  73.                 GADGETS '"Exit"'
  74.   exit 10
  75.   end
  76.  
  77. signal on ERROR
  78. signal on IOERR
  79.  
  80. signal on FAILURE
  81. /*signal on NOVALUE*/
  82. signal on SYNTAX
  83.  
  84.  
  85. /* do the hard part */
  86.  
  87. numflames= 0
  88.  
  89. COMPLETE 0; MESSAGE CLEAR; MESSAGE OPEN; WORKING '"Please wait..."'
  90. MESSAGE '"Generating temporary index' tempfile 'from' pathname '..."'
  91. address command 'List ALL DIRS DIR "' || pathname || '" LFORMAT "%p%n" NOHEAD TO "' || tempfile || '"'
  92.  
  93. CALL init_gauge(tempfile,2)
  94.  
  95. if ~open('fp',tempfile,'R') then do
  96.   REQUESTCHOICE TITLE   '"CutTree Request"',
  97.                 BODY    '"Could not open temporary file*n*n'     ||,
  98.                         ESC'c'ESC'b' || tempfile || ESC'n'ESC'l' || '"',
  99.                 GADGETS '"Exit"'
  100.   exit 10
  101.   end
  102.  
  103. do until eof('fp')
  104.  
  105.   pname= strip( readln('fp') )
  106.   if (words(pname) > 0) & exists(pname) then do
  107.  
  108.     MESSAGE '"Processing' pname '..."'
  109.     address command 'List ALL FILES DIR "' || pname || '" LFORMAT "%l" NOHEAD TO "' || tempsize || '"'
  110.     CALL step_gauge(1)
  111.  
  112.     numfiles = 0
  113.     if open('sfp',tempsize,'R') then do
  114.       numbytes= 0
  115.       do until eof('sfp')
  116.         l = strip( readln('sfp') )
  117.         if words(l) > 0 then do
  118.           numbytes = numbytes + l /* I love REXX */
  119.           numfiles = numfiles + 1
  120.           end
  121.         end
  122.       call close('sfp')
  123.       address command 'Delete QUIET FILE "'tempsize'"'
  124.  
  125.       if (numbytes = 0) & (numfiles = 0) then do
  126.         MESSAGE '"'pname 'is empty ... removing ..."'
  127.         address command 'Protect ALL QUIET FLAGS rwed FILE "' || pname || '"'
  128.         address command 'Delete ALL QUIET FILE "' || pname || '"'
  129.         numflames= numflames + 1
  130.         end
  131.       else MESSAGE '"'pname 'contains' numbytes 'bytes in' numfiles 'file(s)"'
  132.       end
  133.     else MESSAGE '"Error: could not open temporary file' tempsize'"'
  134.     CALL step_gauge(1)
  135.     end
  136.   end
  137. call close('fp')
  138. MESSAGE '"done. ' numflames 'empty directories have been deleted."'
  139. ADDRESS COMMAND 'Delete QUIET FILE "'tempfile'"'
  140. call step_gauge(100)
  141. IF POS('a',cliopts) > 0 THEN MESSAGE CLOSE
  142. exit 0
  143.  
  144. /**/
  145.  
  146. bad_args: PROCEDURE EXPOSE template ESC
  147.   PARSE ARG msg
  148.  
  149.   REQUESTCHOICE TITLE   '"CutTree Request"',
  150.                 BODY    '"' || msg || '*n*n'                     ||,
  151.                         'CutTree args template:*n*n'             ||,
  152.                         ESC'c'ESC'b' || template || ESC'n'ESC'l' || '"',
  153.                 GADGETS '"Okay"'
  154.   RETURN 0
  155.  
  156. /*@*/
  157.  
  158.  
  159. /* translate '"' into '*"' and '*' into '**' */
  160.  
  161. transquote: procedure
  162.   parse arg s
  163.   t= s
  164.   q= max( lastpos('*',s), lastpos('"',s) )
  165.   do while q > 0
  166.     t= insert('*',t,q-1,1)
  167.     s= left(s,q-1)
  168.     q= max( lastpos('*',s), lastpos('"',s) )
  169.     end
  170.   return '"' || t || '"'
  171.  
  172.  
  173. /* return the non-file part of a pathname */
  174.  
  175. pathonly: procedure
  176.   parse arg path
  177.   if (words(path) > 0) & (right(path,1) ~= ':') then do
  178.     if right(path,1) = '/' then path= left(path,length(path)-1)
  179.     if lastpos('/',path) > lastpos(':',path) then path= left(path,lastpos('/',path)-1)
  180.                                              else path= left(path,lastpos(':',path))
  181.     end
  182.   return path
  183.  
  184.  
  185. /* concatenate the filename to the pathname and return the resulting string */
  186.  
  187. tackon: procedure
  188.   parse arg path,file
  189.   do while left(file,1) = '/'
  190.     file= substr(file,2)
  191.     path= pathonly(path)
  192.     end
  193.   if (words(path) > 0) & (right(path,1) ~= '/') & (right(path,1) ~= ':') then path= path || '/'
  194.   if (right(file,1) = '/') then file= left(file,length(file)-1)
  195.   return path || file
  196.  
  197.  
  198. /* create all non-existant directories in a path */
  199.  
  200. makepath: procedure
  201.   parse arg path
  202.   if right(path,1) = '/' then path= left(path,length(path)-1)
  203.   if ~exists(path) then do
  204.     call makepath( pathonly(path) )
  205.     address command 'MakeDir NAME "'path'"'
  206.     end
  207.   return 0
  208.  
  209.  
  210. /*
  211.  * return   1  if the device or volume name in given pathname exists
  212.  *             or if no device or volume was present (current device)
  213.  *          0  if the device or volume name does not exist
  214.  */
  215.  
  216. canexist: procedure
  217.   parse upper arg path
  218.   if pos(':',path) < 1 then return 1 /* current device */
  219.   call pragma('W','N')
  220.   return exists( left(path,lastpos(':',path)) )
  221.  
  222.  
  223. /* stretch the blue completion bar */
  224.  
  225. step_gauge: PROCEDURE EXPOSE dg gstepN
  226.   ARG increment
  227.   gstepN= gstepN + 1
  228.   c= MIN(TRUNC(gstepN * increment * dg),100)
  229.   COMPLETE c
  230.   IF c >= 100 THEN WORKING '"done."'
  231.   RETURN 0
  232.  
  233.  
  234. /* initialize the gauge increment by counting the #of steps to be performed */
  235.  
  236. init_gauge: PROCEDURE EXPOSE dg gstepN
  237.   PARSE ARG fname,steps_per_entry
  238.  
  239.   dg = 0         /* gauge increment */
  240.   gstepN = 0     /* #of performed steps */
  241.  
  242.   IF OPEN('fp',fname,'R') THEN DO
  243.     numentries= 0
  244.     DO UNTIL EOF('fp')
  245.       IF WORDS(READLN('fp')) > 0 THEN
  246.         numentries= numentries+1
  247.       END
  248.     WORKING '"Processing' numentries 'entries..."'
  249.     dg = 100 / (numentries * steps_per_entry)
  250.     CALL SEEK('fp',0,'B')
  251.     CALL CLOSE('fp')
  252.     END
  253.  
  254.   /*MESSAGE CLEAR; MESSAGE OPEN*/
  255.   /*COMPLETE 0*/
  256.   RETURN 0
  257.  
  258.  
  259. /* error/break handling */
  260.  
  261. IOERR:
  262. ERROR:
  263.   err= rc
  264.   ESC = '1b'x
  265.  
  266.   signal off ERROR
  267.   signal off IOERR
  268.  
  269.   WORKING '"I/O problem trapped... Execution halted."'
  270.   MESSAGE '"I/O problem trapped... Execution halted."'
  271.  
  272.   REQUESTCHOICE TITLE   '"CutTree Error Trap' err'"',
  273.                 BODY    '"There was a problem with external I/O in line' sigl '...*n' ||,
  274.                         ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                || '"',
  275.                 GADGETS '"I''ll better exit"'
  276.   exit
  277.  
  278.  
  279. FAILURE:
  280. NOVALUE:
  281. SYNTAX:
  282.   err= rc
  283.   ESC = '1b'x
  284.  
  285.   signal off FAILURE
  286.   signal off NOVALUE
  287.   signal off SYNTAX
  288.  
  289.   WORKING '"Internal problem trapped... Execution halted."'
  290.   MESSAGE '"Internal problem trapped... Execution halted."'
  291.  
  292.   REQUESTCHOICE TITLE   '"CutTree Internal Error' err'"',
  293.                 BODY    '"CutTree seems to have an internal problem in line' sigl '...*n' ||,
  294.                         ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                    || '"',
  295.                 GADGETS '"I''ll better exit"'
  296.   exit
  297.  
  298.  
  299. HALT:
  300. BREAK_C:
  301. BREAK_D:
  302.   signal off HALT
  303.   signal off BREAK_C
  304.   signal off BREAK_D
  305.  
  306.   WORKING '"Break signal trapped... Execution halted."'
  307.   MESSAGE '"Break signal trapped... Execution halted."'
  308.  
  309.   REQUESTCHOICE TITLE   '"CutTree Break Trap"',
  310.                 BODY    '"Script execution halted."',
  311.                 GADGETS '"Stop"'
  312.   exit
  313.